home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 076-100 / disk_091 / adlrun / rtlex.c < prev    next >
C/C++ Source or Header  |  1992-05-06  |  7KB  |  278 lines
  1. #include <ctype.h>
  2. #include <stdio.h>
  3.  
  4. #include "adltypes.h"
  5. #include "adlprog.h"
  6. #include "vstring.h"
  7. #include "adldef.h"
  8. #include "adlrun.h"
  9.  
  10. #define MAXDEPTH    20    /* Maximum nesting of macros */
  11.  
  12. int16
  13.     t_type,        /* Current token type */
  14.     t_val,        /* Current token value */
  15.     read_t;        /* Instruction to lexer to read another token */
  16. char
  17.     *s,            /* Save area for current token */
  18.     *xp;        /* Expansion of s */
  19.  
  20.  
  21.     /***************************************************************\
  22.     *                                *
  23.     *    gettoken() - Read the first token from PSTRING, macro    *
  24.     *    expand it, and place the type and value of the token    *
  25.     *    in t_type and t_val, respectively.  The actual token    *
  26.     *    is located in the external string s.  On an error,    *
  27.     *    t_type will contain one of the following values:    *
  28.     *        -1    :    unknown word            *
  29.     *        -2    :    ambiguous abbreviation        *
  30.     *        -3    :    invalid macro expansion        *
  31.     *                                *
  32.     \***************************************************************/
  33.  
  34. gettoken()
  35. {
  36.     int
  37.     depth,        /* Depth of the macro expansion */
  38.     success;    /* Did the token expand? */
  39.  
  40.  
  41.     /* Check to see whether we want to read a new token */
  42.     if( !read_t ) {
  43.     read_t = 1;
  44.     return;
  45.     }
  46.  
  47.     for( depth = 0; depth < MAXDEPTH; depth++ ) {
  48.     /* Get the first token from the string */
  49.     if( lexer() )
  50.         return;        /* The lexer fully handled the token */
  51.  
  52.     /* Process the token. */
  53.     if( !*s ) {
  54.         /* The string was empty, so return SEP (separator) */
  55.         t_type = SEP;
  56.         t_val = 0;
  57.         return;
  58.     }
  59.     else {
  60.         success = try_expand();
  61.         if( success < 0 ) {
  62.         /* An error occured during expansion */
  63.         t_type = -3;    /* Invalid macro expansion */
  64.         t_val = 0;
  65.         return;
  66.         }
  67.         else if( success == 0 ) {
  68.         /* The token WASN'T a macro, so process it and return. */
  69.         if( numberp( s ) ) {
  70.             /* The token was a number. Coerce it into a string */
  71.             t_type = STRING;
  72.             t_val = newtstr( s );
  73.         }
  74.         else {
  75.             /* The token was an identifier.  Look it up. */
  76.             t_type = lookup( s, &t_val, 1 );
  77.             if( t_type < 0 && wordwrite )
  78.             /* Write the token to the unknown words file */
  79.             fprintf( wordfile, "%s\n", s );
  80.         }
  81.         return;    /* Don't try to further expand this token */
  82.             }
  83.     }
  84.     }
  85.     /* If we get here, we expanded the thing MAXDEPTH times. */
  86.     t_type = -3;    /* Invalid macro expansion */
  87. }
  88.  
  89. /* */
  90.  
  91.     /***************************************************************\
  92.     *                                *
  93.     *    lexer() - read the first token from PSTRING.  Returns    *
  94.     *    1 if the token is a quoted string, 0 otherwise.        *
  95.     *                                *
  96.     \***************************************************************/
  97.  
  98. lexer()
  99. {
  100.     int
  101.     count = 0;    /* Number of chars in the token */
  102.     char
  103.     c,        /* Current char in the token */
  104.     *t;        /* Holding place for the beginning of the token */
  105.  
  106.     eatwhite();        /* Delete leading whitespace */
  107.     t = s;        /* Save the starting address. */
  108.  
  109.     if( *PSTRING ) {
  110.     /* There are indeed non-blank characters in the string */
  111.  
  112.     if( !adlchr( *PSTRING ) ) {
  113.         /* The current character can't appear in an identifier */
  114.  
  115.         if( (*PSTRING == '"') || (*PSTRING == '\'') ) {
  116.         /* We need to (recursively) find a quoted string */
  117.         getquotes( *PSTRING++ );
  118.         *(--s) = '\0';        /* Destroy closing quote */
  119.         s = t;
  120.         t_val = newtstr( s );
  121.         t_type = STRING;
  122.  
  123.         /* Return the fact that we handled everything */
  124.         return 1;
  125.         }
  126.         else
  127.         /* The current character is simply punctuation */
  128.         *s++ = *PSTRING++;
  129.     }
  130.  
  131.     else {
  132.         /* The current character is the first of an identifier */
  133.  
  134.         while( adlchr( c = *PSTRING++ ) ) {
  135.         /* Read the characters into s (iff there is room in s) */
  136.         if( SLEN > ++count ) {
  137.             if( isupper( c ) )
  138.             *s++ = tolower( c );
  139.             else
  140.             *s++ = c;
  141.             }
  142.         }
  143.         PSTRING--;        /* Put back the last character. */
  144.     }
  145.     }
  146.     *s = '\0';            /* Null terminate the string */
  147.     s = t;            /* Point to the beginning of the token */
  148.     return 0;            /* Further processing is required. */
  149. }
  150.  
  151. /* */
  152.  
  153.     /***************************************************************\
  154.     *                                *
  155.     *    try_expand() - attempt to expand the current token.    *
  156.     *    Returns 1 if the token expands, 0 if the token doesn't    *
  157.     *    expand, and -1 if expanding the token would overflow    *
  158.     *    the string.                        *
  159.     *                                *
  160.     \***************************************************************/
  161.  
  162. try_expand()
  163. {
  164.     char
  165.     tsave[ SLEN ];        /* Save area for concatenation */
  166.  
  167.     xp = expand( s );
  168.     if( strcmp( xp, s ) != 0 ) {
  169.     /* The token was a macro - put it in the right place */
  170.  
  171.     if( (strlen( xp ) + strlen( PSTRING )) > (SLEN - 1) ) {
  172.         /* Macro expansion overflow - not enough room */
  173.         return -1;        /* error */
  174.     }
  175.     else {
  176.         /* PSTRING := concat( xp, PSTRING ) */
  177.  
  178.         strcpy( tsave, PSTRING );
  179.         PSTRING = actlist[ curract ].savebuf;
  180.         strcpy( PSTRING, xp );
  181.         strcat( PSTRING, tsave );
  182.         return 1;        /* successful expansion */
  183.     }
  184.     }
  185.     else
  186.     return 0;        /* It didn't expand */
  187. }
  188.  
  189. /* */
  190.  
  191.     /***************************************************************\
  192.     *                                *
  193.     *    numberp( s ) - returns 1 if s is a valid signed        *
  194.     *    integer, 0 otherwise.                    *
  195.     *                                *
  196.     \***************************************************************/
  197.  
  198. numberp( s )
  199. char
  200.     *s;
  201. {
  202.     if( *s == '-' ) {
  203.     /* Preceding minus sign */
  204.     s++;
  205.     if( !*s ) {
  206.         /* Just a minus sign is NOT a number */
  207.         return 0;
  208.     }
  209.     }
  210.     while( *s ) {
  211.     if( !isdigit( *s ) )
  212.         return 0;
  213.     else
  214.         s++;
  215.     }
  216.     return 1;
  217. }
  218.  
  219.  
  220.     /***************************************************************\
  221.     *                                *
  222.     *    getquotes( ch ) - Get a quoted string delimited by ch    *
  223.     *    from PSTRING.  Nesting of strings is allowed, e.g.:    *
  224.     *                                *
  225.     *        'The string "foobar 'bletch'" is legal.'    *
  226.     *                                *
  227.     *    Note that the trailing quote is optional.  If the    *
  228.     *    trailing quote is absent, the end of the string is    *
  229.     *    delimited by the end of the line.            *
  230.     *                                *
  231.     \***************************************************************/
  232.  
  233. getquotes( ch )
  234. int16
  235.     ch;
  236. {
  237.     while( (*PSTRING) && (*PSTRING != ch) ) {
  238.     *s++ = *PSTRING;
  239.     if( (*PSTRING == '\"') || (*PSTRING == '\'') )
  240.         getquotes( *PSTRING++ );
  241.     else
  242.         PSTRING++;
  243.     }
  244.     *s++ = ch;
  245.     if( *PSTRING )
  246.     PSTRING++;        /* Eat up closing quote */
  247. }
  248.  
  249.  
  250.     /***************************************************************\
  251.     *                                *
  252.     *    eatwhite() - Removes leading blanks from PSTRING.    *
  253.     *                                *
  254.     \***************************************************************/
  255.  
  256. eatwhite()
  257. {
  258.     while( (*PSTRING == ' ') || (*PSTRING == '\t') )
  259.     PSTRING++;
  260. }
  261.  
  262.  
  263.  
  264.     /***************************************************************\
  265.     *                                *
  266.     *    adlchr( c ) - returns 1 if c is a valid character in an    *
  267.     *    ADL identifier, 0 otherwise.                *
  268.     *                                *
  269.     \***************************************************************/
  270.  
  271. adlchr( c )
  272. int    c;
  273. {
  274.     return isalnum(c) || (c == '-');
  275. }
  276.  
  277. /*** EOF rtlex.c ***/
  278.